home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 008a / feb93cad.zip / TIP845.LSP < prev    next >
Text File  |  1993-01-14  |  1KB  |  42 lines
  1. ;TIP845: RECT.LSP (C)1993, VICTOR V. JENSEN
  2.  
  3. ; RECT.LSP - rectangle drawing program for Releases 10 & 11.
  4. ; by Victor V. Jensen, April, 1992.
  5.  
  6. (defun recerr (S / A)
  7.  (if (/= S "Function cancelled") (princ (strcat "\nError: " S)))
  8.  (command ".UCS" "P")
  9.  (foreach A s#v (setvar (car A) (cadr A)))
  10.  (setq *error* olderr  s#v nil  olderr nil)
  11.  (princ)
  12. ); end defun recerr
  13.  
  14. (defun C:RECT (/ A PT P1 P2 P3)
  15.  (setvar "CMDECHO" 0)
  16.  (setq A '("AXISMODE" "UCSICON" "UCSFOLLOW" "GRIDMODE" "ORTHOMODE" "COORDS")
  17.   olderr *error*  *error* recerr
  18.      s#v (mapcar '(lambda (PT) (list PT (getvar PT))) A)
  19.  ); setq
  20.  (foreach A s#v
  21.   (if (= (car A) "COORDS") (setvar (car A) 1) (setvar (car A) 0))
  22.  ); foreach
  23.  (initget 1)
  24.  (setq PT (getpoint"\nFirst corner: "))
  25.  (command ".UCS" "O" PT)
  26.  (setq PT (list 0.0 0.0 0.0))
  27.  (initget 1)
  28.  (setq P2 (getcorner PT "\nOpposite corner: ")
  29.        P1 (list (car P2) (cadr PT) (caddr PT))
  30.        P3 (list (car PT) (cadr P2) (caddr P2))
  31.  ); setq
  32.  (command ".PLINE" PT "W" "0" "" P1 P2 P3 "C")
  33.  (setq P1 (getangle PT "\nRotation angle or RETURN for none: "))
  34.  (if (= P1 nil) (setq P1 0))
  35.  (command ".ROTATE" PT "" PT (angtos P1) ".UCS" "P")
  36.  (foreach A s#v (setvar (car A) (cadr A)))
  37.  (setq *error* olderr  s#v nil  olderr nil)
  38.  (princ)
  39. ); end defun c:rect
  40. (princ)
  41. (C:RECT)
  42.